{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$WARN UNSAFE_TYPE OFF}

unit PathInterface;

interface

  uses
    Interface_TLB,
    ComObj,
    ExtActns,
    Classes;

  type TPathInterface = class(TAutoIntfObject, IPathIntf, IDispatch)
    private
      fPath : Widestring;
      fItems : TStringList;
      procedure Setup();
      procedure DeleteTree(FolderPath : Widestring);
    protected
      function Get_Path: WideString; safecall;
      procedure Set_Path(const Value: WideString); safecall;
      procedure Delete; safecall;
      function Get_isFile: WordBool; safecall;
      function Get_itemCount: Integer; safecall;
      function Items(index: Integer): OleVariant; safecall;
      property Path: WideString read Get_Path write Set_Path;
      property isFile: WordBool read Get_isFile;
      property itemCount: Integer read Get_itemCount;
    public
      constructor Create(CompletePath : Widestring);
      destructor Destroy(); override;
  end;

implementation

  uses
    ActiveX,
    Windows,
    SysUtils,
    Variants,
    ShellAPI;

  constructor TPathInterface.Create(CompletePath : Widestring);
  var
    TypeLib : ITypeLib;
    ExeName : WideString;
  begin
    //Get name of application
    ExeName := ParamStr(0);
    //Load type library from application's resources
    OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib));
    //Inherit
    inherited Create(TypeLib, IPathIntf);
    //Set path
    fPath := CompletePath;
    if DirectoryExists(fPath) and (fPath[Length(fPath)] <> '\') then
      fPath := fPath + '\';
  end;

  destructor TPathInterface.Destroy();
  begin
    inherited;
  end;

  procedure TPathInterface.Setup();
  var
    SearchRecord : TSearchRec;
  begin
    if isFile = false then
    begin
      if fItems <> nil then
        fItems.Clear
      else
        fItems := TStringList.Create();
      if FindFirst(fPath + '*.*', faAnyFile, SearchRecord) = 0 then
        repeat
          fItems.Add(SearchRecord.Name);
        until FindNext(SearchRecord) <> 0;
      FindClose(SearchRecord);
    end;
  end;

  procedure TPathInterface.DeleteTree(FolderPath : Widestring);
  var
    SearchRecord : TSearchRec;
  begin
    if FindFirst(FolderPath + '*.*', faAnyFile, SearchRecord) = 0 then
    repeat
      if (SearchRecord.Name <> '.') and (SearchRecord.Name <> '..') then
        if SearchRecord.Attr and faDirectory > 0 then
          DeleteTree(FolderPath + SearchRecord.Name)
      else
       DeleteFile(FolderPath + SearchRecord.Name);
    until FindNext(SearchRecord) <> 0;
    RemoveDir(ExtractFileDir(FolderPath));
    FindClose(SearchRecord);
  end;

  function TPathInterface.Get_Path() : Widestring;
  begin
    Result := fPath;
  end;

  procedure TPathInterface.Set_Path(const Value: WideString);
  begin
      if MoveFile(PWideChar(fPath), PWideChar(Value)) then fPath := Value;
  end;

  procedure TPathInterface.Delete();
  begin
    try
      try
        SetFileAttributes(PWideChar(fPath), FILE_ATTRIBUTE_NORMAL);
      except end;
      if isFile then
      begin
        DeleteFile(PWideChar(fPath));
      end else begin
        DeleteTree(PWideChar(fPath));
        RemoveDir(fPath);
      end;
    except end;
  end;

  function TPathInterface.Get_isFile() : Wordbool;
  begin
    Result := FileExists(fPath);
  end;

  function TPathInterface.Get_itemCount() : Integer;
  begin
    if isFile = false then
    begin
      Setup();
      Result := fItems.Count;
    end else
     Result := 0;
  end;

  function TPathInterface.Items(index: Integer) : OleVariant;
  begin
    Result := VarAsType(Result, varEmpty);
    if isFile = false then
    begin
      Setup();
      if (index >= 0) and (index < fItems.Count) then
        try
          Result := IDispatch(TPathInterface.Create(fPath + fItems.Strings[index]));
        except end;
    end;
  end;

end.
